home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / gnu / perl5000.zip / perl5000 / doop.c < prev    next >
C/C++ Source or Header  |  1994-10-17  |  13KB  |  670 lines
  1. /*    doop.c
  2.  *
  3.  *    Copyright (c) 1991-1994, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  */
  9.  
  10. /*
  11.  * "'So that was the job I felt I had to do when I started,' thought Sam."
  12.  */
  13.  
  14. #include "EXTERN.h"
  15. #include "perl.h"
  16.  
  17. #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
  18. #include <signal.h>
  19. #endif
  20.  
  21. #ifdef BUGGY_MSC
  22.  #pragma function(memcmp)
  23. #endif /* BUGGY_MSC */
  24.  
  25. #ifdef BUGGY_MSC
  26.  #pragma intrinsic(memcmp)
  27. #endif /* BUGGY_MSC */
  28.  
  29. I32
  30. do_trans(sv,arg)
  31. SV *sv;
  32. OP *arg;
  33. {
  34.     register short *tbl;
  35.     register char *s;
  36.     register I32 matches = 0;
  37.     register I32 ch;
  38.     register char *send;
  39.     register char *d;
  40.     register I32 squash = op->op_private & OPpTRANS_SQUASH;
  41.     STRLEN len;
  42.  
  43.     if (SvREADONLY(sv))
  44.     croak(no_modify);
  45.     tbl = (short*) cPVOP->op_pv;
  46.     s = SvPV(sv, len);
  47.     if (!len)
  48.     return 0;
  49.     if (!SvPOKp(sv))
  50.     s = SvPV_force(sv, len);
  51.     (void)SvPOK_only(sv);
  52.     send = s + len;
  53.     if (!tbl || !s)
  54.     croak("panic: do_trans");
  55.     DEBUG_t( deb("2.TBL\n"));
  56.     if (!op->op_private) {
  57.     while (s < send) {
  58.         if ((ch = tbl[*s & 0377]) >= 0) {
  59.         matches++;
  60.         *s = ch;
  61.         }
  62.         s++;
  63.     }
  64.     }
  65.     else {
  66.     d = s;
  67.     while (s < send) {
  68.         if ((ch = tbl[*s & 0377]) >= 0) {
  69.         *d = ch;
  70.         if (matches++ && squash) {
  71.             if (d[-1] == *d)
  72.             matches--;
  73.             else
  74.             d++;
  75.         }
  76.         else
  77.             d++;
  78.         }
  79.         else if (ch == -1)        /* -1 is unmapped character */
  80.         *d++ = *s;        /* -2 is delete character */
  81.         s++;
  82.     }
  83.     matches += send - d;    /* account for disappeared chars */
  84.     *d = '\0';
  85.     SvCUR_set(sv, d - SvPVX(sv));
  86.     }
  87.     SvSETMAGIC(sv);
  88.     return matches;
  89. }
  90.  
  91. void
  92. do_join(sv,del,mark,sp)
  93. register SV *sv;
  94. SV *del;
  95. register SV **mark;
  96. register SV **sp;
  97. {
  98.     SV **oldmark = mark;
  99.     register I32 items = sp - mark;
  100.     register STRLEN len;
  101.     STRLEN delimlen;
  102.     register char *delim = SvPV(del, delimlen);
  103.     STRLEN tmplen;
  104.  
  105.     mark++;
  106.     len = (items > 0 ? (delimlen * (items - 1) ) : 0);
  107.     if (SvTYPE(sv) < SVt_PV)
  108.     sv_upgrade(sv, SVt_PV);
  109.     if (SvLEN(sv) < len + items) {    /* current length is way too short */
  110.     while (items-- > 0) {
  111.         if (*mark) {
  112.         SvPV(*mark, tmplen);
  113.         len += tmplen;
  114.         }
  115.         mark++;
  116.     }
  117.     SvGROW(sv, len + 1);        /* so try to pre-extend */
  118.  
  119.     mark = oldmark;
  120.     items = sp - mark;;
  121.     ++mark;
  122.     }
  123.  
  124.     if (items-- > 0) {
  125.     char *s;
  126.  
  127.     if (*mark) {
  128.         s = SvPV(*mark, tmplen);
  129.         sv_setpvn(sv, s, tmplen);
  130.     }
  131.     else
  132.         sv_setpv(sv, "");
  133.     mark++;
  134.     }
  135.     else
  136.     sv_setpv(sv,"");
  137.     len = delimlen;
  138.     if (len) {
  139.     for (; items > 0; items--,mark++) {
  140.         sv_catpvn(sv,delim,len);
  141.         sv_catsv(sv,*mark);
  142.     }
  143.     }
  144.     else {
  145.     for (; items > 0; items--,mark++)
  146.         sv_catsv(sv,*mark);
  147.     }
  148.     SvSETMAGIC(sv);
  149. }
  150.  
  151. void
  152. do_sprintf(sv,len,sarg)
  153. register SV *sv;
  154. register I32 len;
  155. register SV **sarg;
  156. {
  157.     register char *s;
  158.     register char *t;
  159.     register char *f;
  160.     bool dolong;
  161. #ifdef QUAD
  162.     bool doquad;
  163. #endif /* QUAD */
  164.     char ch;
  165.     register char *send;
  166.     register SV *arg;
  167.     char *xs;
  168.     I32 xlen;
  169.     I32 pre;
  170.     I32 post;
  171.     double value;
  172.     STRLEN arglen;
  173.  
  174.     sv_setpv(sv,"");
  175.     len--;            /* don't count pattern string */
  176.     t = s = SvPV(*sarg, arglen);    /* XXX Don't know t is writeable */
  177.     send = s + arglen;
  178.     sarg++;
  179.     for ( ; ; len--) {
  180.  
  181.     /*SUPPRESS 560*/
  182.     if (len <= 0 || !(arg = *sarg++))
  183.         arg = &sv_no;
  184.  
  185.     /*SUPPRESS 530*/
  186.     for ( ; t < send && *t != '%'; t++) ;
  187.     if (t >= send)
  188.         break;        /* end of run_format string, ignore extra args */
  189.     f = t;
  190.     *buf = '\0';
  191.     xs = buf;
  192. #ifdef QUAD
  193.     doquad =
  194. #endif /* QUAD */
  195.     dolong = FALSE;
  196.     pre = post = 0;
  197.     for (t++; t < send; t++) {
  198.         switch (*t) {
  199.         default:
  200.         ch = *(++t);
  201.         *t = '\0';
  202.         (void)sprintf(xs,f);
  203.         len++, sarg--;
  204.         xlen = strlen(xs);
  205.         break;
  206.         case '0': case '1': case '2': case '3': case '4':
  207.         case '5': case '6': case '7': case '8': case '9': 
  208.         case '.': case '#': case '-': case '+': case ' ':
  209.         continue;
  210.         case 'l':
  211. #ifdef QUAD
  212.         if (dolong) {
  213.             dolong = FALSE;
  214.             doquad = TRUE;
  215.         } else
  216. #endif
  217.         dolong = TRUE;
  218.         continue;
  219.         case 'c':
  220.         ch = *(++t);
  221.         *t = '\0';
  222.         xlen = SvIV(arg);
  223.         if (strEQ(f,"%c")) { /* some printfs fail on null chars */
  224.             *xs = xlen;
  225.             xs[1] = '\0';
  226.             xlen = 1;
  227.         }
  228.         else {
  229.             (void)sprintf(xs,f,xlen);
  230.             xlen = strlen(xs);
  231.         }
  232.         break;
  233.         case 'D':
  234.         dolong = TRUE;
  235.         /* FALL THROUGH */
  236.         case 'd':
  237.         ch = *(++t);
  238.         *t = '\0';
  239. #ifdef QUAD
  240.         if (doquad)
  241.             (void)sprintf(buf,s,(quad)SvNV(arg));
  242.         else
  243. #endif
  244.         if (dolong)
  245.             (void)sprintf(xs,f,(long)SvNV(arg));
  246.         else
  247.             (void)sprintf(xs,f,SvIV(arg));
  248.         xlen = strlen(xs);
  249.         break;
  250.         case 'X': case 'O':
  251.         dolong = TRUE;
  252.         /* FALL THROUGH */
  253.         case 'x': case 'o': case 'u':
  254.         ch = *(++t);
  255.         *t = '\0';
  256.         value = SvNV(arg);
  257. #ifdef QUAD
  258.         if (doquad)
  259.             (void)sprintf(buf,s,(unsigned quad)value);
  260.         else
  261. #endif
  262.         if (dolong)
  263.             (void)sprintf(xs,f,U_L(value));
  264.         else
  265.             (void)sprintf(xs,f,U_I(value));
  266.         xlen = strlen(xs);
  267.         break;
  268.         case 'E': case 'e': case 'f': case 'G': case 'g':
  269.         ch = *(++t);
  270.         *t = '\0';
  271.         (void)sprintf(xs,f,SvNV(arg));
  272.         xlen = strlen(xs);
  273.         break;
  274.         case 's':
  275.         ch = *(++t);
  276.         *t = '\0';
  277.         xs = SvPV(arg, arglen);
  278.         xlen = (I32)arglen;
  279.         if (strEQ(f,"%s")) {    /* some printfs fail on >128 chars */
  280.             break;        /* so handle simple cases */
  281.         }
  282.         else if (f[1] == '-') {
  283.             char *mp = strchr(f, '.');
  284.             I32 min = atoi(f+2);
  285.  
  286.             if (mp) {
  287.             I32 max = atoi(mp+1);
  288.  
  289.             if (xlen > max)
  290.                 xlen = max;
  291.             }
  292.             if (xlen < min)
  293.             post = min - xlen;
  294.             break;
  295.         }
  296.         else if (isDIGIT(f[1])) {
  297.             char *mp = strchr(f, '.');
  298.             I32 min = atoi(f+1);
  299.  
  300.             if (mp) {
  301.             I32 max = atoi(mp+1);
  302.  
  303.             if (xlen > max)
  304.                 xlen = max;
  305.             }
  306.             if (xlen < min)
  307.             pre = min - xlen;
  308.             break;
  309.         }
  310.         strcpy(tokenbuf+64,f);    /* sprintf($s,...$s...) */
  311.         *t = ch;
  312.         (void)sprintf(buf,tokenbuf+64,xs);
  313.         xs = buf;
  314.         xlen = strlen(xs);
  315.         break;
  316.         }
  317.         /* end of switch, copy results */
  318.         *t = ch;
  319.         SvGROW(sv, SvCUR(sv) + (f - s) + xlen + 1 + pre + post);
  320.         sv_catpvn(sv, s, f - s);
  321.         if (pre) {
  322.         repeatcpy(SvPVX(sv) + SvCUR(sv), " ", 1, pre);
  323.         SvCUR(sv) += pre;
  324.         }
  325.         sv_catpvn(sv, xs, xlen);
  326.         if (post) {
  327.         repeatcpy(SvPVX(sv) + SvCUR(sv), " ", 1, post);
  328.         SvCUR(sv) += post;
  329.         }
  330.         s = t;
  331.         break;        /* break from for loop */
  332.     }
  333.     }
  334.     sv_catpvn(sv, s, t - s);
  335.     SvSETMAGIC(sv);
  336. }
  337.  
  338. void
  339. do_vecset(sv)
  340. SV *sv;
  341. {
  342.     SV *targ = LvTARG(sv);
  343.     register I32 offset;
  344.     register I32 size;
  345.     register unsigned char *s;
  346.     register unsigned long lval;
  347.     I32 mask;
  348.     STRLEN targlen;
  349.     STRLEN len;
  350.  
  351.     if (!targ)
  352.     return;
  353.     s = (unsigned char*)SvPV_force(targ, targlen);
  354.     lval = U_L(SvNV(sv));
  355.     offset = LvTARGOFF(sv);
  356.     size = LvTARGLEN(sv);
  357.     
  358.     len = (offset + size + 7) / 8;
  359.     if (len > targlen) {
  360.     s = (unsigned char*)SvGROW(targ, len + 1);
  361.     (void)memzero(s + targlen, len - targlen + 1);
  362.     SvCUR_set(targ, len);
  363.     }
  364.     
  365.     if (size < 8) {
  366.     mask = (1 << size) - 1;
  367.     size = offset & 7;
  368.     lval &= mask;
  369.     offset >>= 3;
  370.     s[offset] &= ~(mask << size);
  371.     s[offset] |= lval << size;
  372.     }
  373.     else {
  374.     offset >>= 3;
  375.     if (size == 8)
  376.         s[offset] = lval & 255;
  377.     else if (size == 16) {
  378.         s[offset] = (lval >> 8) & 255;
  379.         s[offset+1] = lval & 255;
  380.     }
  381.     else if (size == 32) {
  382.         s[offset] = (lval >> 24) & 255;
  383.         s[offset+1] = (lval >> 16) & 255;
  384.         s[offset+2] = (lval >> 8) & 255;
  385.         s[offset+3] = lval & 255;
  386.     }
  387.     }
  388. }
  389.  
  390. void
  391. do_chop(astr,sv)
  392. register SV *astr;
  393. register SV *sv;
  394. {
  395.     STRLEN len;
  396.     char *s;
  397.     
  398.     if (SvTYPE(sv) == SVt_PVAV) {
  399.     register I32 i;
  400.         I32 max;
  401.     AV* av = (AV*)sv;
  402.         max = AvFILL(av);
  403.         for (i = 0; i <= max; i++) {
  404.         sv = (SV*)av_fetch(av, i, FALSE);
  405.         if (sv && ((sv = *(SV**)sv), sv != &sv_undef))
  406.         do_chop(astr, sv);
  407.     }
  408.         return;
  409.     }
  410.     if (SvTYPE(sv) == SVt_PVHV) {
  411.         HV* hv = (HV*)sv;
  412.     HE* entry;
  413.         (void)hv_iterinit(hv);
  414.         /*SUPPRESS 560*/
  415.         while (entry = hv_iternext(hv))
  416.             do_chop(astr,hv_iterval(hv,entry));
  417.         return;
  418.     }
  419.     s = SvPV(sv, len);
  420.     if (len && !SvPOKp(sv))
  421.     s = SvPV_force(sv, len);
  422.     if (s && len) {
  423.     s += --len;
  424.     sv_setpvn(astr, s, 1);
  425.     *s = '\0';
  426.     SvCUR_set(sv, len);
  427.     SvNIOK_off(sv);
  428.     }
  429.     else
  430.     sv_setpvn(astr, "", 0);
  431.     SvSETMAGIC(sv);
  432. } 
  433.  
  434. I32
  435. do_chomp(sv)
  436. register SV *sv;
  437. {
  438.     register I32 count = 0;
  439.     STRLEN len;
  440.     char *s;
  441.     
  442.     if (SvTYPE(sv) == SVt_PVAV) {
  443.     register I32 i;
  444.         I32 max;
  445.     AV* av = (AV*)sv;
  446.         max = AvFILL(av);
  447.         for (i = 0; i <= max; i++) {
  448.         sv = (SV*)av_fetch(av, i, FALSE);
  449.         if (sv && ((sv = *(SV**)sv), sv != &sv_undef))
  450.         count += do_chomp(sv);
  451.     }
  452.         return count;
  453.     }
  454.     if (SvTYPE(sv) == SVt_PVHV) {
  455.         HV* hv = (HV*)sv;
  456.     HE* entry;
  457.         (void)hv_iterinit(hv);
  458.         /*SUPPRESS 560*/
  459.         while (entry = hv_iternext(hv))
  460.             count += do_chomp(hv_iterval(hv,entry));
  461.         return count;
  462.     }
  463.     s = SvPV(sv, len);
  464.     if (len && !SvPOKp(sv))
  465.     s = SvPV_force(sv, len);
  466.     if (s && len) {
  467.     s += --len;
  468.     if (rspara) {
  469.         if (*s != '\n')
  470.         goto nope;
  471.         ++count;
  472.         while (len && s[-1] == '\n') {
  473.         --len;
  474.         --s;
  475.         ++count;
  476.         }
  477.     }
  478.     else if (rslen == 1) {
  479.         if (*s != rschar)
  480.         goto nope;
  481.         ++count;
  482.     } 
  483.     else {
  484.         if (len < rslen - 1)
  485.         goto nope;
  486.         len -= rslen - 1;
  487.         s -= rslen - 1;
  488.         if (bcmp(s, rs, rslen))
  489.         goto nope;
  490.         count += rslen;
  491.     }
  492.  
  493.     *s = '\0';
  494.     SvCUR_set(sv, len);
  495.     SvNIOK_off(sv);
  496.     }
  497.   nope:
  498.     SvSETMAGIC(sv);
  499.     return count;
  500. } 
  501.  
  502. void
  503. do_vop(optype,sv,left,right)
  504. I32 optype;
  505. SV *sv;
  506. SV *left;
  507. SV *right;
  508. {
  509. #ifdef LIBERAL
  510.     register long *dl;
  511.     register long *ll;
  512.     register long *rl;
  513. #endif
  514.     register char *dc;
  515.     STRLEN leftlen;
  516.     STRLEN rightlen;
  517.     register char *lc = SvPV(left, leftlen);
  518.     register char *rc = SvPV(right, rightlen);
  519.     register I32 len;
  520.     I32 lensave;
  521.  
  522.     dc = SvPV_force(sv,na);
  523.     len = leftlen < rightlen ? leftlen : rightlen;
  524.     lensave = len;
  525.     if (SvCUR(sv) < len) {
  526.     dc = SvGROW(sv,len + 1);
  527.     (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
  528.     }
  529.     SvCUR_set(sv, len);
  530.     (void)SvPOK_only(sv);
  531. #ifdef LIBERAL
  532.     if (len >= sizeof(long)*4 &&
  533.     !((long)dc % sizeof(long)) &&
  534.     !((long)lc % sizeof(long)) &&
  535.     !((long)rc % sizeof(long)))    /* It's almost always aligned... */
  536.     {
  537.     I32 remainder = len % (sizeof(long)*4);
  538.     len /= (sizeof(long)*4);
  539.  
  540.     dl = (long*)dc;
  541.     ll = (long*)lc;
  542.     rl = (long*)rc;
  543.  
  544.     switch (optype) {
  545.     case OP_BIT_AND:
  546.         while (len--) {
  547.         *dl++ = *ll++ & *rl++;
  548.         *dl++ = *ll++ & *rl++;
  549.         *dl++ = *ll++ & *rl++;
  550.         *dl++ = *ll++ & *rl++;
  551.         }
  552.         break;
  553.     case OP_BIT_XOR:
  554.         while (len--) {
  555.         *dl++ = *ll++ ^ *rl++;
  556.         *dl++ = *ll++ ^ *rl++;
  557.         *dl++ = *ll++ ^ *rl++;
  558.         *dl++ = *ll++ ^ *rl++;
  559.         }
  560.         break;
  561.     case OP_BIT_OR:
  562.         while (len--) {
  563.         *dl++ = *ll++ | *rl++;
  564.         *dl++ = *ll++ | *rl++;
  565.         *dl++ = *ll++ | *rl++;
  566.         *dl++ = *ll++ | *rl++;
  567.         }
  568.     }
  569.  
  570.     dc = (char*)dl;
  571.     lc = (char*)ll;
  572.     rc = (char*)rl;
  573.  
  574.     len = remainder;
  575.     }
  576. #endif
  577.     {
  578.     char *lsave = lc;
  579.     char *rsave = rc;
  580.     
  581.     switch (optype) {
  582.     case OP_BIT_AND:
  583.         while (len--)
  584.         *dc++ = *lc++ & *rc++;
  585.         break;
  586.     case OP_BIT_XOR:
  587.         while (len--)
  588.         *dc++ = *lc++ ^ *rc++;
  589.         goto mop_up;
  590.     case OP_BIT_OR:
  591.         while (len--)
  592.         *dc++ = *lc++ | *rc++;
  593.       mop_up:
  594.         len = lensave;
  595.         if (rightlen > len)
  596.         sv_catpvn(sv, rsave + len, rightlen - len);
  597.         else if (leftlen > len)
  598.         sv_catpvn(sv, lsave + len, leftlen - len);
  599.         break;
  600.     }
  601.     }
  602. }
  603.  
  604. OP *
  605. do_kv(ARGS)
  606. dARGS
  607. {
  608.     dSP;
  609.     HV *hv = (HV*)POPs;
  610.     I32 i;
  611.     register HE *entry;
  612.     char *tmps;
  613.     SV *tmpstr;
  614.     I32 dokeys =   (op->op_type == OP_KEYS);
  615.     I32 dovalues = (op->op_type == OP_VALUES);
  616.  
  617.     if (op->op_type == OP_RV2HV || op->op_type == OP_PADHV) 
  618.     dokeys = dovalues = TRUE;
  619.  
  620.     if (!hv)
  621.     RETURN;
  622.     if (GIMME != G_ARRAY) {
  623.     dTARGET;
  624.  
  625.     if (!SvRMAGICAL(hv) || !mg_find((SV*)hv,'P'))
  626.         i = HvKEYS(hv);
  627.     else {
  628.         i = 0;
  629.         (void)hv_iterinit(hv);
  630.         /*SUPPRESS 560*/
  631.         while (entry = hv_iternext(hv)) {
  632.         i++;
  633.         }
  634.     }
  635.     PUSHi( i );
  636.     RETURN;
  637.     }
  638.  
  639.     /* Guess how much room we need.  hv_max may be a few too many.  Oh well. */
  640.     EXTEND(sp, HvMAX(hv) * (dokeys + dovalues));
  641.  
  642.     (void)hv_iterinit(hv);
  643.  
  644.     PUTBACK;    /* hv_iternext and hv_iterval might clobber stack_sp */
  645.     while (entry = hv_iternext(hv)) {
  646.     SPAGAIN;
  647.     if (dokeys) {
  648.         tmps = hv_iterkey(entry,&i);    /* won't clobber stack_sp */
  649.         if (!i)
  650.         tmps = "";
  651.         XPUSHs(sv_2mortal(newSVpv(tmps,i)));
  652.     }
  653.     if (dovalues) {
  654.         tmpstr = NEWSV(45,0);
  655.         PUTBACK;
  656.         sv_setsv(tmpstr,hv_iterval(hv,entry));
  657.         SPAGAIN;
  658.         DEBUG_H( {
  659.         sprintf(buf,"%d%%%d=%d\n",entry->hent_hash,
  660.             HvMAX(hv)+1,entry->hent_hash & HvMAX(hv));
  661.         sv_setpv(tmpstr,buf);
  662.         } )
  663.         XPUSHs(sv_2mortal(tmpstr));
  664.     }
  665.     PUTBACK;
  666.     }
  667.     return NORMAL;
  668. }
  669.  
  670.